df <- readRDS("life_expectancy_data.RDS")
# str(df)
#2
# Сделайте интерактивный plotly график любых двух нумерических колонок.
# Раскрасть по колонке континента, на котором расположена страна
plot_ly(data = df,
x = ~"Urban population",
y = ~Unemployment,
color = ~continent)
#3
# Проведите тест, на сравнение распределений колонки Life expectancy между группами стран Africa и Americas.
# Визуализируйте результат через библиотеку rstatix.
stat.test <- df %>%
filter(continent %in% c("Africa", "Americas")) %>% # Из колонки continet выбрать Africa и Americas.
t_test(`Life expectancy` ~ continent, paired = FALSE, var.equal = FALSE) # Провести тест на сравнение распределений колонки Life expectancy между группами стран Africa и Americas.
df %>% filter(continent %in% c("Africa", "Americas")) %>%
ggboxplot(, x = "continent", y = "Life expectancy",
color = "continent", palette = "jco") +
stat_pvalue_manual(stat.test, label = "T-test, p = {p}", y.position = 90)
#4
# Сделайте новый датафрейм, в котором оставите все численные колонки кроме `Year`.
df_new <- df %>%
select_if(is.numeric) %>%
select(-c(Year)) #Remove column Year
# Сделайте корреляционный анализ этих данных.
df_cor <- df_new %>%
cor() # Сделать корреляционный анализ этих данных.
# Постройте два любых типа графиков для визуализации корреляций.
library(corrplot)
corrplot(df_cor, method = "color", type = "lower")
corrplot(df_cor, order = 'AOE', addCoef.col = 'grey', type = "lower")
#5
# Постройте иерархическую кластеризацию на этом датафрейме.
library(factoextra)
df_hc <- df_new %>%
scale() %>%
dist() %>%
hclust(method = "ward.D2")
fviz_dend(df_hc, k = 5, cex = 0.5, k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07", "#000000"), rect = TRUE)
#6
# Сделайте одновременный график heatmap и иерархической кластеризации.
library(pheatmap)
df_new_scaled <- scale(df_new)
df_new_dist <- dist(df_new_scaled,
method = "euclidean"
)
as.matrix(df_new_dist)[1:19,1:19]
## 1 2 3 4 5 6 7 8
## 1 0.000000 7.605708 6.331840 4.414874 6.645623 7.923487 6.871952 5.775284
## 2 7.605708 0.000000 2.624659 7.921597 3.357361 3.631018 2.133443 4.865266
## 3 6.331840 2.624659 0.000000 6.321666 4.350331 3.464837 1.838549 4.682283
## 4 4.414874 7.921597 6.321666 0.000000 8.095849 7.161240 7.283456 6.457741
## 5 6.645623 3.357361 4.350331 8.095849 0.000000 4.966244 3.718748 4.520093
## 6 7.923487 3.631018 3.464837 7.161240 4.966244 0.000000 3.179530 4.404796
## 7 6.871952 2.133443 1.838549 7.283456 3.718748 3.179530 0.000000 4.594832
## 8 5.775284 4.865266 4.682283 6.457741 4.520093 4.404796 4.594832 0.000000
## 9 8.835860 3.261894 4.287235 8.640651 4.944358 3.684951 4.148218 5.407914
## 10 8.203865 3.698898 4.821052 8.218066 4.289648 3.775455 4.073212 4.524401
## 11 6.771398 3.064625 3.832113 7.592264 3.144182 3.857818 2.905244 4.534745
## 12 6.697490 3.114600 2.621443 6.517353 4.030377 2.531003 2.810808 4.343917
## 13 9.140180 4.965395 5.365812 8.660365 5.254845 2.977044 5.124600 5.092104
## 14 5.638149 3.911833 4.313035 6.869575 4.014239 5.889312 4.399305 5.193076
## 15 6.796045 3.162983 4.179209 7.944277 2.731182 5.067138 3.262920 5.051520
## 16 9.047803 4.297519 5.403885 9.198490 5.586638 4.455736 4.504410 5.920632
## 17 9.409794 4.120026 5.023094 9.117988 5.927094 3.915660 4.826477 5.502644
## 18 6.667480 2.453498 2.919712 7.300679 2.819080 3.799518 2.514739 3.871719
## 19 3.978002 6.752884 5.889843 4.444999 6.764628 7.187521 6.594851 5.644682
## 9 10 11 12 13 14 15 16
## 1 8.835860 8.203865 6.771398 6.697490 9.140180 5.638149 6.796045 9.047803
## 2 3.261894 3.698898 3.064625 3.114600 4.965395 3.911833 3.162983 4.297519
## 3 4.287235 4.821052 3.832113 2.621443 5.365812 4.313035 4.179209 5.403885
## 4 8.640651 8.218066 7.592264 6.517353 8.660365 6.869575 7.944277 9.198490
## 5 4.944358 4.289648 3.144182 4.030377 5.254845 4.014239 2.731182 5.586638
## 6 3.684951 3.775455 3.857818 2.531003 2.977044 5.889312 5.067138 4.455736
## 7 4.148218 4.073212 2.905244 2.810808 5.124600 4.399305 3.262920 4.504410
## 8 5.407914 4.524401 4.534745 4.343917 5.092104 5.193076 5.051520 5.920632
## 9 0.000000 2.772419 4.243617 3.156793 4.808394 5.842146 4.609660 4.120531
## 10 2.772419 0.000000 3.494538 3.575486 5.169400 5.971755 3.439392 3.369383
## 11 4.243617 3.494538 0.000000 3.118681 5.075474 4.330886 2.333936 3.209857
## 12 3.156793 3.575486 3.118681 0.000000 4.071196 5.002832 3.964020 4.635718
## 13 4.808394 5.169400 5.075474 4.071196 0.000000 6.686242 6.423881 5.971556
## 14 5.842146 5.971755 4.330886 5.002832 6.686242 0.000000 4.462912 6.498890
## 15 4.609660 3.439392 2.333936 3.964020 6.423881 4.462912 0.000000 4.314716
## 16 4.120531 3.369383 3.209857 4.635718 5.971556 6.498890 4.314716 0.000000
## 17 1.951186 3.250184 4.734474 3.998209 5.017776 6.658400 5.547892 3.549275
## 18 4.622121 4.610368 3.425612 3.541824 4.491591 3.373591 3.697246 5.520709
## 19 7.931192 7.693712 6.510924 6.266811 8.339966 4.642946 6.766453 8.311677
## 17 18 19
## 1 9.409794 6.667480 3.978002
## 2 4.120026 2.453498 6.752884
## 3 5.023094 2.919712 5.889843
## 4 9.117988 7.300679 4.444999
## 5 5.927094 2.819080 6.764628
## 6 3.915660 3.799518 7.187521
## 7 4.826477 2.514739 6.594851
## 8 5.502644 3.871719 5.644682
## 9 1.951186 4.622121 7.931192
## 10 3.250184 4.610368 7.693712
## 11 4.734474 3.425612 6.510924
## 12 3.998209 3.541824 6.266811
## 13 5.017776 4.491591 8.339966
## 14 6.658400 3.373591 4.642946
## 15 5.547892 3.697246 6.766453
## 16 3.549275 5.520709 8.311677
## 17 0.000000 5.426551 8.422190
## 18 5.426551 0.000000 5.975659
## 19 8.422190 5.975659 0.000000
pheatmap(df_new_scaled,
scale = "row",
clastering_distance_rows = df_new_dist,
claster_method = "ward.D2",
cutree_rows = 5, # группируем (условно) по континентам
cutree_cols = length(colnames(df_new_scaled))
)
# Подробно объясните результат кластеризации.
print(paste0("Можно предположить: 1) есть положительная связь между сельским населением и показателями заболеваний и смертности; 2) Есть положительная связь между городским населением и технологией, иммунизацией, стоимостью жизни; 3) Нет сязи между валовым национальным продуктом (GNI) и валовым внутренним продуктом (GPD), но есть положительная связь между безработицей и валовыми продуктами"))
## [1] "Можно предположить: 1) есть положительная связь между сельским населением и показателями заболеваний и смертности; 2) Есть положительная связь между городским населением и технологией, иммунизацией, стоимостью жизни; 3) Нет сязи между валовым национальным продуктом (GNI) и валовым внутренним продуктом (GPD), но есть положительная связь между безработицей и валовыми продуктами"
#7
# Проведите PCA анализ на этих данных.
library(FactoMineR)
df_full.pca <- prcomp(df_new,
scale = TRUE)
summary(df_full.pca)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.7526 1.4841 1.3952 1.17177 1.08375 0.96347 0.9288
## Proportion of Variance 0.3988 0.1159 0.1025 0.07227 0.06182 0.04886 0.0454
## Cumulative Proportion 0.3988 0.5147 0.6172 0.68945 0.75126 0.80012 0.8455
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.85740 0.69263 0.68937 0.59106 0.54986 0.47085 0.36596
## Proportion of Variance 0.03869 0.02525 0.02501 0.01839 0.01591 0.01167 0.00705
## Cumulative Proportion 0.88421 0.90946 0.93447 0.95286 0.96877 0.98044 0.98749
## PC15 PC16 PC17 PC18 PC19
## Standard deviation 0.34546 0.26941 0.20224 0.06968 1.017e-15
## Proportion of Variance 0.00628 0.00382 0.00215 0.00026 0.000e+00
## Cumulative Proportion 0.99377 0.99759 0.99974 1.00000 1.000e+00
# plot(df_full.pca, main = "")
# #
# barplot(df_full.pca$rotation[,1], main = "", names.arg = colnames(df_new), las = 3)
fviz_eig(df_full.pca, addlabels = TRUE)
fviz_pca_var(df_full.pca, col.var = "contrib")
fviz_pca_var(df_full.pca,
select.var = list(contrib = 3), # Задаём число здесь
col.var = "contrib")
fviz_contrib(df_full.pca, choice = "var", axes = 1, top = 24) # 1
fviz_contrib(df_full.pca, choice = "var", axes = 2, top = 24) # 2
fviz_contrib(df_full.pca, choice = "var", axes = 3, top = 24) # 3
# fviz_contrib(df_full.pca, choice = "var", axes = 4, top = 24) # 4
# fviz_contrib(df_full.pca, choice = "var", axes = 5, top = 24) # 5
# Проинтерпретируйте результат.
print(paste0("На уровне PC5 объясняется 75% всех вариаций данных. Такие данные не являются хорошими для анализа главных компонентов."))
## [1] "На уровне PC5 объясняется 75% всех вариаций данных. Такие данные не являются хорошими для анализа главных компонентов."
#8
# Постройте biplot график для PCA. Раскрасьте его по значениям континентов.
library(ggbiplot)
ggbiplot(df_full.pca,
scale=0,
groups = as.factor(df$continent),
ellipse = TRUE,
alpha = 0.2) +
theme_minimal()
# Переведите его в `plotly`.При наведении на точку выводить (hover) название страны из колонки Country.
library(plotly)
ggbiplot(df_full.pca,
scale=0,
groups = as.factor(df$continent),
ellipse = TRUE,
alpha = 0.2) +
theme_minimal() -> p
plotly_build(p) %>%
plotly::add_trace(
x = df_full.pca$x[,1],
y = df_full.pca$x[,2],
text = df$Country,
hoverinfo = "text",
showlegend = FALSE,
# mode = "markers",
# type = "scatter",
marker = list(
color = df$continent,
size = 0.1
)
) %>%
plotly::layout(
hovermode = "closest"
)
#9
# Дайте содержательную интерпретацию PCA анализу.
print(paste0("Из векторов близко лежащиех друг другу можно взять одну для представления их связи с другими признаками. Большие значения стомиости жизни и технологий будут пренадлежать с большей вероятности Европе. И это гипотезу можно проверять. Также можно сказать, что векторы смертности и заболеваний будут близко лежать друг к другу, что говорит о том, что они связаны между собой. И они будут характеризовать Африку (в большей стемени), Океанию и Азию. Также можно сказать, что векторы безработицы и валового национального продукта будут близко лежать друг к другу, что говорит о том, что они связаны между собой. И они будут характеризовать Африку (в большей стемени), Океанию и Азию. Городское население обратно пропоцианально лечению туберкулёза. И, напротив, сельское население совпадает с ветором лечения туберкулёза. "))
## [1] "Из векторов близко лежащиех друг другу можно взять одну для представления их связи с другими признаками. Большие значения стомиости жизни и технологий будут пренадлежать с большей вероятности Европе. И это гипотезу можно проверять. Также можно сказать, что векторы смертности и заболеваний будут близко лежать друг к другу, что говорит о том, что они связаны между собой. И они будут характеризовать Африку (в большей стемени), Океанию и Азию. Также можно сказать, что векторы безработицы и валового национального продукта будут близко лежать друг к другу, что говорит о том, что они связаны между собой. И они будут характеризовать Африку (в большей стемени), Океанию и Азию. Городское население обратно пропоцианально лечению туберкулёза. И, напротив, сельское население совпадает с ветором лечения туберкулёза. "
#10
# Сравните результаты отображения точек между алгоритмами PCA и UMAP.
#11
# Давайте самостоятельно увидим, что снижение размерности – это группа методов, славящаяся своей неустойчивостью. Удалите 5 случайных колонок.
df_new %>%
select(-c(1,4,5,10,19)) %>%
prcomp(scale = TRUE) -> df_full_short.pca
df_new %>%
select(-c(1,3,6,11,14)) %>%
prcomp(scale = TRUE) -> df_full_short.pca_2
df_new %>%
select(-c(2, 4, 5, 9, 19)) %>%
prcomp(scale = TRUE) -> df_full_short.pca_3
# Проведите PCA анализ. Повторите результат 3 раза. Наблюдаете ли вы изменения в куммулятивном проценте объяснённой вариации?
summary(df_full_short.pca)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.499 1.3204 1.08787 0.96616 0.92400 0.89131 0.78907
## Proportion of Variance 0.446 0.1245 0.08453 0.06668 0.06098 0.05674 0.04447
## Cumulative Proportion 0.446 0.5705 0.65505 0.72173 0.78271 0.83945 0.88393
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.68770 0.6513 0.56092 0.42306 0.35079 0.33342 4.507e-16
## Proportion of Variance 0.03378 0.0303 0.02247 0.01278 0.00879 0.00794 0.000e+00
## Cumulative Proportion 0.91771 0.9480 0.97049 0.98327 0.99206 1.00000 1.000e+00
summary(df_full_short.pca_2)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.100 1.3824 1.2856 1.15473 1.02493 0.93028 0.88925
## Proportion of Variance 0.315 0.1365 0.1181 0.09524 0.07504 0.06182 0.05648
## Cumulative Proportion 0.315 0.4515 0.5696 0.66480 0.73983 0.80165 0.85813
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.79453 0.68407 0.6787 0.55318 0.33936 0.07210 2.391e-16
## Proportion of Variance 0.04509 0.03343 0.0329 0.02186 0.00823 0.00037 0.000e+00
## Cumulative Proportion 0.90322 0.93665 0.9696 0.99140 0.99963 1.00000 1.000e+00
summary(df_full_short.pca_3)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.6618 1.4570 1.03368 0.93894 0.83457 0.78806 0.72492
## Proportion of Variance 0.5061 0.1516 0.07632 0.06297 0.04975 0.04436 0.03754
## Cumulative Proportion 0.5061 0.6577 0.73404 0.79701 0.84676 0.89112 0.92866
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.62366 0.47532 0.37552 0.3549 0.2725 0.20645 3.227e-16
## Proportion of Variance 0.02778 0.01614 0.01007 0.0090 0.0053 0.00304 0.000e+00
## Cumulative Proportion 0.95644 0.97258 0.98265 0.9917 0.9970 1.00000 1.000e+00
print(paste0("Да, наблюдаются. Рекомендованное значение в 75% достигается на уровне РС5 в первом случае, на уровне РС6 во втором случае и на уровне РС4 в третьем случае."))
## [1] "Да, наблюдаются. Рекомендованное значение в 75% достигается на уровне РС5 в первом случае, на уровне РС6 во втором случае и на уровне РС4 в третьем случае."
fviz_eig(df_full_short.pca, addlabels = TRUE)
fviz_eig(df_full_short.pca_2, addlabels = TRUE)
fviz_eig(df_full_short.pca_3, addlabels = TRUE)
# В итоговом представлении данных на биплотах?
fviz_pca_var(df_full_short.pca,
select.var = list(contrib = 3), # Задаём число здесь
col.var = "contrib")
fviz_pca_var(df_full_short.pca_2,
select.var = list(contrib = 3), # Задаём число здесь
col.var = "contrib")
fviz_pca_var(df_full_short.pca_3,
select.var = list(contrib = 3), # Задаём число здесь
col.var = "contrib")
# С чем связаны изменения между тремя PCA?
print(paste0("Потому что мы удалили 5 случайных колонок, которые могли быть важными для объяснения вариации."))
## [1] "Потому что мы удалили 5 случайных колонок, которые могли быть важными для объяснения вариации."
# fviz_contrib(df_full_short.pca, choice = "var", axes = 1, top = 24) # 1
# fviz_contrib(df_full_short.pca, choice = "var", axes = 2, top = 24) # 2
# fviz_contrib(df_full_short.pca, choice = "var", axes = 3, top = 24) # 3
#
# fviz_contrib(df_full_short.pca_2, choice = "var", axes = 1, top = 24) # 1
# fviz_contrib(df_full_short.pca_2, choice = "var", axes = 2, top = 24) # 2
# fviz_contrib(df_full_short.pca_2, choice = "var", axes = 3, top = 24) # 3
#
# fviz_contrib(df_full_short.pca_3, choice = "var", axes = 1, top = 24) # 1
# fviz_contrib(df_full_short.pca_3, choice = "var", axes = 2, top = 24) # 2
# fviz_contrib(df_full_short.pca_3, choice = "var", axes = 3, top = 24) # 3
#12
# Давайте самостоятельно увидим, что снижение размерности – это группа методов, славящаяся своей неустойчивостью.
# Создайте две дамми-колонки о том: (1) принадлежит ли страна к африканскому континенту, (2) Океании.
# Проведите PCA вместе с ними, постройте биплоты. Проинтерпрейтируйте результат.
# Объясните, почему добавление дамми-колонок не совсем корректно в случае PCA нашего типа